MacHack 1998/MacHack 1998.toast/Programming Contest/Secret Solutions Folder/Problem 07 - Graph/Solution.p

Text File | 1998-06-13 | 4.4 KB | 149 lines | [TEXT/CWIE]

(*
Problem 07 - Graph

procedure GraphInit( var graph: Handle; verrticies: UInt32 );
procedure GraphAddDirectedEdge( graph: Handle; vertex1, vertex2: UInt32 );
procedure GraphFindRoute( graph: Handle; vertex1, vertex2: UInt32; var verticies: Handle );

GraphInit creates a new, empty directed graph ready to accept directed edges with verrticies verrticies.  All the graph information must be stored in the real Mac memory manager handle - it will be disposed with DisposeHandle and that must release all memory, so dont store any extra information outside the handle.  Also, you must be able to deal with having multiple graphs instantiated simultaneously.

GraphAddDirectedEdge adds a directed edge from vertex1 to vertex2

GraphFindRoute find a route from vertex1 to vertex2.  If such a route exists, then verticies is returns as a real Mac handle to an array of UInt32s, the first is vertex1, the last is vertex2.  Each successive vertex must have previously had an edge added with GraphAddDirectedEdge.  If no route exists, return nil for verticies.  No vertex should appear more than once in the verticies handle, except for the case where vertex1 is the same as vertex2, in which case you must find a circular route from vertex1 back to itself and so vertex1 will appear exactly twice, once at the start and once at the end of the verticies handle.
*)

unit Solution;

interface

// Do not modify the interface

    uses
        Types, Files;

    type
        UInt32Array = array[0..0] of UInt32;
        UInt32ArrayPtr = ^UInt32Array;
        UInt32ArrayHandle = ^UInt32ArrayPtr;

    procedure GraphInit( var graph: Handle; verticies: UInt32 );
    procedure GraphAddDirectedEdge( graph: Handle; vertex1, vertex2: UInt32 );
    procedure GraphFindRoute( graph: Handle; vertex1, vertex2: UInt32; var verticies: UInt32ArrayHandle );

implementation

// Fill in your solution and then submit this folder

// Team Name: Example Solution
// 15:25
// 15:42
// 15:49
// 15:55

    uses
        ToolUtils;

    function GetVerticies( graph: Handle ): UInt32;
    begin
        GetVerticies := UInt32ArrayHandle(graph)^^[0];
    end;

    function GetBitArrayStart( graph: Handle ): Ptr;
    begin
        GetBitArrayStart := Ptr(longint(graph^)+(1 + GetVerticies(graph))*4);
    end;

    procedure SetABit( graph: Handle; v1, v2: UInt32 );
    begin
        BitSet( GetBitArrayStart( graph ),(v1-1) * GetVerticies(graph) + (v2-1) );
    end;

    function TestABit( graph: Handle; v1, v2: UInt32 ): boolean;
    begin
        TestABit := BitTst( GetBitArrayStart( graph ),(v1-1) * GetVerticies(graph) + (v2-1) );
    end;

    procedure GraphInit( var graph: Handle; verticies: UInt32 );
    begin
        graph := NewHandleClear( (1 + verticies) * 4 + verticies * verticies div 8 + 1 );
        if graph <> nil then begin
            UInt32ArrayHandle(graph)^^[0] := verticies;
        end;
    end;

    procedure GraphAddDirectedEdge( graph: Handle; vertex1, vertex2: UInt32 );
    begin
        HLock( graph );
        SetABit( graph, vertex1, vertex2 );
        HUnlock( graph );
    end;

    procedure GraphFindRoute( graph: Handle; vertex1, vertex2: UInt32; var verticies: UInt32ArrayHandle );
        const
            no_route = $7FFFFFFF;
        var
            count, routecount: UInt32;
            counts: UInt32ArrayPtr;
            i, j, k: UInt32;
            continue: boolean;
    begin
        HLock( graph );
        count := GetVerticies( graph );
        counts := UInt32ArrayHandle(graph)^;

        // Initialize counts
        for i := 1 to count do begin
            if TestABit( graph, vertex1, i ) then begin
                counts^[i] := 1;
            end else begin
                counts^[i] := no_route;
            end;
        end;

        // Flood fill
        for i := 1 to count do begin
            if counts^[vertex2] <> no_route then begin
                leave;
            end;
            continue := false;
            for j := 1 to count do begin
                if counts^[j] = i then begin
                    for k := 1 to count do begin
                        if (counts^[k] = no_route) & TestABit( graph, j, k ) then begin
                            counts^[k] := i + 1;
                            continue := true;
                        end;
                    end;
                end;
            end;
            if not continue then begin
                leave;
            end;
        end;

        // Answer
        if counts^[vertex2] = no_route then begin
            verticies := nil;
        end else begin
            routecount := counts^[vertex2];
            verticies := UInt32ArrayHandle( NewHandleClear( (routecount + 1) * 4 ));
            if verticies <> nil then begin
                verticies^^[0] := vertex1;
                verticies^^[routecount] := vertex2;
                for i := routecount-1 downto 1 do begin
                    for j := 1 to count do begin
                        if TestABit( graph, j, vertex2 ) & (counts^[j] = i) then begin
                            verticies^^[i] := j;
                            vertex2 := j;
                            leave;
                        end;
                    end;
                end;
            end;
        end;

        HUnlock( graph );
    end;

end.